home *** CD-ROM | disk | FTP | other *** search
- SUBROUTINE PROCES
- *-----------------------------------------------------------------------
- *
- * Processes one routine statement by statement:
- * filtering, replacements
- *
- *-----------------------------------------------------------------------
- include 'PARAM.h'
- include 'ALCAZA.h'
- include 'CLASS.h'
- include 'FLAGS.h'
- include 'CURSTA.h'
- include 'STATE.h'
- include 'JOBSUM.h'
- LOGICAL SAMEST
- *--- treat routine header and init
- CALL RSTART
- *--- TREE preparation if no proper header
- IF(ACTION(29).AND.SCROUT.EQ.'NOHEADER') CALL TREEST(0)
- *--- user top of routine
- IF(ACTION(22)) CALL URINIT
-
- *--- NP controls the number of blank lines for print headers
- NP=0
- *--- process only if routine selected
- IF (STATUS(7)) THEN
- *--- loop over all statements in routine
- DO 60 IST=1,NSTAMM
- STATUS(8)=.TRUE.
- STATUS(10)=.TRUE.
- STATUS(11)=.FALSE.
- IF (ICLASS(IST,1).GT.0) THEN
- *--- extract and set classes
- CALL EXTRAC(IST,'FULL')
- ICURCL(1)=ICLASS(IST,1)
- ICURCL(2)=ICLASS(IST,2)
- IF (ICURCL(1).EQ.ILL) NFDCLS(ILL,1)=NFDCLS(ILL,1)+1
- ENDIF
- IF (ICLASS(IST,1).EQ.ILL.AND.ACTION(3)) THEN
- IF (STATUS(9)) THEN
- STATUS(9)=.FALSE.
- IF (ACTION(6)) THEN
- WRITE (MPUNIT,10000) 'all',SCROUT
- ELSE
- WRITE (MPUNIT,10000) 'selected',SCROUT
- ENDIF
- ENDIF
- STATUS(10)=.FALSE.
- CALL FLPRNT(1,'illegal',NLLINE(IST)-NFLINE(IST)+1,SIMA(
- + NFLINE(IST)),NSTATC(8))
- NP=1
- *--- print all if requested
- ELSEIF (ACTION(6)) THEN
- *--- routine header
- IF (STATUS(9)) THEN
- STATUS(9)=.FALSE.
- WRITE (MPUNIT,10000) 'all',SCROUT
- ENDIF
- STATUS(10)=.FALSE.
- CALL FLPRNT(NP,' ',NLLINE(IST)-NFLINE(IST)+1,SIMA(NFLINE(
- + IST)),NSTATC(8))
- NP=0
- ENDIF
- *--- call user routine for ALL statements
- IF(ACTION(22)) CALL USSALL
- *--- process only legal FORTRAN statements
- IF (ICLASS(IST,1).GT.0.AND.ICLASS(IST,1).NE.ILL) THEN
- *--- get statement number
- SNEWST(1)(1:6)=SIMA(NFLINE(IST))(1:6)
- *--- filter for classes
- IF (ACTION(17)) CALL FILTER(13,8)
- IF (STATUS(8)) THEN
- *--- get statement names
- ISNAME=IRNAME+NRNAME
- CALL GETALL
- *--- filter for names
- IF (ACTION(18)) CALL FILTER(11,8)
- IF (STATUS(8)) THEN
- *--- filter for strings
- IF (ACTION(19)) CALL FILTER(12,8)
- IF (STATUS(8)) THEN
- *--- all filters passed - update statistics
- IMODIF(IST)=1
- NSTATC(4)=NSTATC(4)+1
- NFDCLS(ICURCL(1),1)=NFDCLS(ICURCL(1),1)+1
- IF (ICURCL(1).EQ.IIF) NFDCLS(ICURCL(2),2)=NFDCLS
- + (ICURCL(2),2)+1
- *--- user start of statement
- IF(ACTION(22)) CALL USSBEG
- *--- prepare indentation if requested
- IF(ACTION(21)) CALL PROIND
- *----get type for variables
- IF (ACTION(20)) CALL SETTYP(1)
- *--- check for incorrect relational operators in character type
- CALL CHKCHR
- *--- treat names further if any
- IF(NSNAME.GT.0) THEN
- *--- prepare TREE output
- IF(ACTION(29)) CALL TREEST(1)
- *--- find used and unused common blocks
- IF(ACTION(24).AND..NOT.STATUS(12))
- + CALL PROCOM
- *--- perform name replacements
- IF (ACTION(15)) CALL REPNAM
- IF (STATUS(11)) GOTO 10
- IF (ACTION(1).OR.ACTION(2)) THEN
- *--- add names to routine name list
- CALL LSORT(SNAMES(ISNAME+1),
- + NAMTYP(ISNAME+1),.TRUE.,NSNAME)
- CALL LMERGE(SNAMES,NAMTYP,.TRUE.,IRNAME,
- + NRNAME,NSNAME)
- CALL SUPMOR(SNAMES,NAMTYP,.TRUE.,IRNAME,
- + NRNAME+NSNAME,NRNAME)
- ENDIF
- ENDIF
- IF (ACTION(5).AND.STATUS(10)) THEN
- *--- print filtered
- IF (STATUS(9)) THEN
- WRITE (MPUNIT,10000) 'filtered',SCROUT
- STATUS(9)=.FALSE.
- ENDIF
- STATUS(10)=.FALSE.
- CALL FLPRNT(NP,' ',NLLINE(IST)-NFLINE(IST)+1,
- + SIMA(NFLINE(IST)),NSTATC(8))
- NP=0
- ENDIF
- IF (ACTION(11).OR.ACTION(12)) THEN
- *--- remove {} , change holl. to quotes if requested
- CALL QUOSUB
- IF (STATUS(11)) GOTO 10
- *--- string replacement
- IF(ACTION(12)) CALL REPSTR
- IF (STATUS(11)) GOTO 10
- *--- re-insert {} around strings for REFORM
- CALL MARKST('FULL',IERR)
- STATUS(11)=IERR.NE.0
- IF (STATUS(11)) GOTO 10
- ENDIF
- *--- re-numbering if requested
- IF (ACTION(13)) CALL RENUMB
- *--- user end of statement
- IF(ACTION(22)) CALL USSEND
- ENDIF
- ENDIF
- ENDIF
- *--- here you arrive without filter checks
- 10 CONTINUE
- IFILTR=0
- IF (STATUS(11)) IMODIF(IST)=MOD(IMODIF(IST),10)
- *--- reformat = put modified statement into SIMA
- IF (IMODIF(IST).GT.10.OR.ACTION(21).AND.IMODIF(IST).GT.0)
- + THEN
- CALL REFORM
- *--- not changed if REFORM problem, or identical after REFORM
- IF (STATUS(11).OR.SAMEST(IST))
- + IMODIF(IST)=MOD(IMODIF(IST),10)
- ENDIF
- IF (IMODIF(IST).GT.10) THEN
- *--- count changed statements
- NSTATC(5)=NSTATC(5)+1
- IF (ACTION(4).AND.STATUS(10)) THEN
- *--- print changed statements
- IF (STATUS(9)) THEN
- WRITE (MPUNIT,10000) 'changed',SCROUT
- STATUS(9)=.FALSE.
- ENDIF
- CALL FLPRNT(1,' ',NLLINE(IST)-NFLINE(IST)+1,SIMA(
- + NFLINE(IST)),NSTATC(8))
- ENDIF
- *--- re-formatted statement in SNEWST
- * put into SIMA, push SIMA if new longer than old, introduce blank
- * lines if new shorter than old
- N=0
- DO 20 I=NFLINE(IST),NLLINE(IST)
- IF (NLTYPE(I).NE.0) THEN
- N=N+1
- IF (N.GT.NEWOUT) THEN
- SIMA(I)=' '
- ELSE
- SIMA(I)=SNEWST(N)
- ENDIF
- ENDIF
- 20 CONTINUE
- NPUSH=NEWOUT-N
- IF (NPUSH.GT.0) THEN
- DO 30 I=NLINES,NLLINE(IST)+1,-1
- NLTYPE(I+NPUSH)=NLTYPE(I)
- SIMA(I+NPUSH)=SIMA(I)
- 30 CONTINUE
- NLINES=NLINES+NPUSH
- *--- loop over all statements since they might be in a different order
- DO 40 I=1,NSTAMM
- IF(NFLINE(I).GT.NFLINE(IST)) THEN
- NFLINE(I)=NFLINE(I)+NPUSH
- NLLINE(I)=NLLINE(I)+NPUSH
- ENDIF
- 40 CONTINUE
- DO 50 I=1,NPUSH
- SIMA(NLLINE(IST)+I)=SNEWST(N+I)
- 50 CONTINUE
- NLLINE(IST)=NLLINE(IST)+NPUSH
- ENDIF
- IF (ACTION(4)) THEN
- CALL FLPRNT(0,'changed to',NLLINE(IST)-NFLINE(IST)+
- + 1,SIMA(NFLINE(IST)),NDUMMY)
- NP=1
- ENDIF
- ENDIF
- ENDIF
- 60 CONTINUE
- ENDIF
- *--- user end of routine
- IF(ACTION(22)) CALL URTERM
- *--- TREE output if any
- IF(ACTION(29)) CALL TREESU
- 10000 FORMAT(/1X,20('++++'),A10,' statements, routine =',A10)
- 999 END
-